home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / image / multi207.zip / SKAL.BAS < prev    next >
BASIC Source File  |  1997-02-08  |  19KB  |  742 lines
  1. '0.84
  2. declare sub drwaline(byval colrbits%,byval colr%,byval x1%,byval y1%,byval x2%,byval y2%)
  3. declare sub drwline(byval mode%,byval colr%,byval x1%,byval y1%,byval x2%,byval y2%)
  4. declare function getmaxx%()
  5. declare function getmaxy%()
  6. declare sub mouseinfo(seg drvmajorver%,seg drvminorver%,seg mousetype%,seg irqnumber%)
  7. declare sub palset(palstring$,byval firstcolr%,byval lastcolr%)
  8. declare function pcxgetinfo%(filename$,seg pcxxsize%,seg pcxysize%,seg numcolors%,pal$)
  9. declare function pcxmake%(byval x1%,byval y1%,byval x2%,byval y2%,filename$)
  10. declare function pcxput%(byval mode%,byval xloc%,byval yloc%,name$)
  11. declare function res320%()
  12. declare function res640l%()
  13. declare function res640%()
  14. declare function res800%()
  15. declare function res1024%()
  16. declare function res1280%()
  17. declare function restext%()
  18. declare sub setview(byval x1%,byval y1%,byval x2%,byval y2%)
  19. declare function videomodeget%()
  20. declare sub videomodeset(byval mode%)
  21. declare function whichcpu%()
  22. declare function whichjoystick%()
  23. declare function whichmem%()
  24. declare function whichmouse%()
  25. declare function whichvga%()
  26. declare function whichxms%(seg xmskbytesavailable%,seg xmshandlesavailable%)
  27. defint a-z
  28. declare sub interrupt(intnum as integer,inregs as any,outregs as any)
  29. declare function monitor%(segment)
  30. dim file$(99)
  31.  
  32. type regtype
  33.      ax as integer
  34.      bx as integer
  35.      cx as integer
  36.      dx as integer
  37.      bp as integer
  38.      si as integer
  39.      di as integer
  40.      flags as integer
  41. end type
  42.  
  43. dim shared inregs as regtype,outregs as regtype
  44. count=1
  45. getfrill$=right$(command$,1)
  46.  
  47. if getfrill$="P" or getfrill$="A" then antialia$="A"
  48. cls
  49. slidesho$=mid$(command$,1,2)
  50. gosub prepares
  51.  
  52. if slidesho$="SS" then
  53.      slshow=1
  54.      goto showslid
  55. endif
  56.  
  57. if slidesho$="/A" goto artshow
  58.  
  59. pcxshow$=mid$(command$,2,1)
  60.  
  61. if pcxshow$="S" then
  62.      pcxfilename$=mid$(command$,4)
  63.      gosub showpcx
  64.      videomodeset startvideomode
  65.      end
  66. endif
  67.  
  68. getline:
  69. randomize timer
  70. gosub setpoint
  71. l=p1
  72.  
  73. for p1=sizetype to getmaxx step 3
  74.      p4=p4-2
  75.      gosub setsymme
  76.      gosub makeline
  77. next
  78.  
  79. if getfrill$="P" then
  80.      gosub continue:
  81.      if ucase$(a$)="C" or a$=chr$(13) then
  82.           pcxfile$="C"
  83.           countstr$=str$(count)
  84.           countstr$=ltrim$(countstr$)
  85.           countstr$=rtrim$(countstr$)
  86.           pcxfile$=pcxfile$+countstr$+".PCX"
  87.           returnco=pcxmake (0,0,getmaxx,getmaxy,pcxfile$)
  88.           if returnco<>1 then
  89.                videomodeset startvideomode
  90.                print "Unable to create .PCX file
  91.                end
  92.           endif
  93.           count=count+1
  94.           goto getline
  95.      endif
  96.      if a$=chr$(27) then
  97.           videomodeset startvideomode
  98.           end
  99.      endif
  100. endif
  101.  
  102. a$=inkey$
  103.  
  104. if a$>"" then
  105.      videomodeset startvideomode
  106.      end
  107. endif
  108.  
  109. goto getline
  110.  
  111. setpoint:
  112. p1=int(rnd(1)*getmaxx)
  113. p2=int(rnd(1)*getmaxy)
  114. p3=int(rnd(1)*getmaxx)
  115. p4=int(rnd(1)*getmaxy)
  116. sw=int(rnd(1)*256)
  117. return
  118.  
  119. setsymme:
  120. m1=getmaxx-p1
  121. m2=getmaxy-p2
  122. m3=getmaxx-p3
  123. m4=getmaxy-p4
  124. return
  125.  
  126. makeline:
  127.  
  128. if antialia$="A" then
  129.      drwaline 3,sw,p1,p2,p3,p4
  130.      drwaline 3,sw,m1,m2,m3,m4
  131.      drwaline 3,sw,p1,m2,p3,m4
  132.      drwaline 3,sw,m1,p2,m3,p4
  133.      return
  134. endif
  135.  
  136. drwline 1,sw,p1,p2,p3,p4
  137. drwline 1,sw,m1,m2,m3,m4
  138. drwline 1,sw,p1,m2,p3,m4
  139. drwline 1,sw,m1,p2,m3,p4
  140. return
  141.  
  142. prepares:
  143. if command$="" goto noclp
  144. cpu=whichcpu
  145.  
  146. if cpu<386 or cpu=9991 then
  147.      print "You need a 386SX or better for this program.
  148.      end
  149. endif
  150.  
  151. if command$="REPORT" goto report
  152. startvideomode=videomodeget
  153. dummy=restext
  154. cls
  155. justvga$=left$(command$,1)
  156. if justvga$="0" goto vgaonly
  157. vga=whichvga
  158.  
  159. if vga<1 or vga>20 then
  160.      print "You need SVGA graphics capabilities for this program.
  161.      end
  162. endif
  163.  
  164. vgaonly:
  165.  
  166. select case mid$(command$,1,2)
  167.      case "0","0A"
  168.           gosub getvga
  169.           if standard=0 then
  170.                print "You need VGA for this option."
  171.                end
  172.           endif
  173.           dummy=res320
  174.      case "1","1A","1P","1S"
  175.           dummy=res640l
  176.           videomode=1
  177.      case "2","2A","2P","2S"
  178.           dummy=res640
  179.           videomode=2
  180.      case "3","3A","3P","3S"
  181.           dummy=res800
  182.           videomode=3
  183.      case "4","4A","4P","4S"
  184.           dummy=res1024
  185.           videomode=4
  186.      case "5","5A","5P","5S"
  187.           dummy=res1280
  188.           videomode=5
  189.      case "SS"
  190.           return
  191.      case "/A"
  192.           return
  193.      case "REPORT"
  194.           goto report
  195.      case else
  196. noclp:
  197.           cls
  198.           print "Syntax: SKAL option
  199.           print
  200.           print "Where option is one of the following:
  201.           print
  202.           print "0  -    320 X 200 X 256; better symmetry
  203.           print "0A -    320 X 200 X 256; spiffier patterns
  204.           print "1  -    640 X 400 X 256; better symmetry
  205.           print "1A -    640 X 400 X 256; spiffier patterns
  206.           print "1P -    640 X 400 X 256; screen capture (see documentation)
  207.           print "2  -    640 X 480 X 256; better symmetry
  208.           print "2A -    640 X 480 X 256; spiffier patterns
  209.           print "2P -    640 X 480 X 256; screen capture (see documentation)
  210.           print "3  -    800 X 600 X 256; better symmetry
  211.           print "3A -    800 X 600 X 256; spiffier patterns
  212.           print "3P -    800 X 600 X 256; screen capture (see documentation)
  213.           print "4  -   1024 X 768 X 256; better symmetry
  214.           print "4A -   1024 X 768 X 256; spiffier patterns
  215.           print "4P -   1024 X 768 X 256; screen capture (see documentation)
  216.           print "5  -  1280 X 1024 X 256; better symmetry
  217.           print "5A -  1280 X 1024 X 256; spiffier patterns
  218.           print "5P -  1280 X 1024 X 256; screen capture (see documentation)
  219.           print "REPORT - System information
  220.           print
  221.           print "Press a key... ";
  222.           gosub continue
  223.           cls
  224.           print ".PCX file display syntax: SKAL n filename.PCX
  225.           print
  226.           print "where n is the mode number (example: SKAL 1 TEST.PCX)
  227.           print
  228.           print "Slide show syntax: SKAL SS filelist.txt
  229.           print
  230.           print "where filelist.txt is a text file containing the mode number and a list of .PCX
  231.           print "files to display
  232.           print
  233.           print "Please see the documentation for further information."
  234.           print
  235.           end
  236. end select
  237.  
  238. setview 0,0,getmaxx,getmaxy
  239. return
  240.  
  241. report:
  242. cls
  243. cpu=whichcpu
  244.  
  245. print "Central Processing Unit: ";
  246.  
  247. select case cpu
  248.      case 134:
  249.           print "8086 or 8088"
  250.      case 9991
  251.           print "8088-2"
  252.      case 286:
  253.           print "80286"
  254.      case 386:
  255.           print "80386"
  256.      case 486:
  257.           print "80486"
  258.      case 586:
  259.           print "Pentium"
  260.      case else
  261.           print "Unknown
  262. end select
  263.  
  264. print
  265. print "Mouse status:
  266. print
  267. mouse=whichmouse
  268. if mouse>0 then
  269.      mouseinfo mjv, mnv, tp, i
  270.      mver$=str$(mjv)
  271.      mver$=ltrim$(mver$)
  272.      mver$=rtrim$(mver$)
  273.      miver$=str$(mnv)
  274.      miver$=ltrim$(miver$)
  275.      miver$=rtrim$(miver$)
  276.      driver$=mver$+"."+miver$
  277.      print "Software driver version: "driver$
  278.      print "Mouse type: ";
  279.      select case tp
  280.           case 1
  281.                print "Bus
  282.           case 2
  283.                print "Serial
  284.           case 3
  285.                print "Inport
  286.           case 4
  287.                print "PS/2
  288.           case 5
  289.                print "HP
  290.           case else
  291.                print "Unknown
  292.      end select
  293.      print "Buttons: "str$(mouse)
  294.      print "IRQ Number: "str$(i)
  295. else
  296.      print "No Microsoft compatible mouse detected."
  297. endif
  298.  
  299. print
  300. print "Joystick status: ";
  301. joystick=whichjoystick
  302.  
  303. select case joystick
  304.      case -1
  305.           print "No joystick port detected or no joystick BIOS support present."
  306.      case 0
  307.           print "No joystick detected."
  308.      case 1
  309.           print "Joystick A is present and available."
  310.      case 2
  311.           print "Joystick B is present and available."
  312.      case 3
  313.           print "Both Joystick A and Joystick B are present and available."
  314. end select
  315.  
  316. print
  317. print "Extended Memory (XMS) status:
  318. print
  319. if whichxms(mem,handles)=1 then
  320.      xmsmem$=str$(mem)
  321.      xmsmem$=ltrim$(xmsmem$)
  322.      xmsmem$=rtrim$(xmsmem$)
  323.      xmshandl$=str$(handles)
  324.      xmshandl$=ltrim$(xmshandl$)
  325.      xmshandl$=rtrim$(xmshandl$)
  326.      print "XMS memory manager found.
  327.      print xmsmem$"K of extended memory available.
  328.      print xmshandl$" handles are available.
  329. else
  330.      print "No XMS memory manager found.
  331. endif
  332.  
  333. print
  334. print "Press a key... ";
  335. gosub continue:
  336. cls
  337.  
  338. vga=whichvga
  339. print "The following graphics capabilities were detected:
  340. print
  341.  
  342. select case vga
  343.      case 0:
  344.           print "No SVGA graphics detected."
  345.           print
  346.           gosub getvideo
  347.           end
  348.      case 1:
  349.           print "Acumos AVGA2/3 SuperVGA"
  350.      case 2:
  351.           print "ATI Technologies 18/28/38/68800 SuperVGA"
  352.      case 3:
  353.           print "Ahead V5000 ver A SuperVGA"
  354.      case 4:
  355.           print "Ahead V5000 ver B SuperVGA"
  356.      case 5:
  357.           print "Chips and Technologies 82C450/1/2/3/5/6/7 SuperVGA"
  358.      case 6:
  359.           print "Cirrus Logic CL-GD 5xx,6xx,28xx,54xx,62xx SuperVGA"
  360.      case 7:
  361.           print "Everex Ev236/6xx Micro Enhancer SuperVGA"
  362.      case 8:
  363.           print "Genoa 61/62/63/64/6600 SuperVGA"
  364.      case 9:
  365.           print "NCR 77C21/22/22E/22E+ SuperVGA"
  366.      case 10:
  367.           print "Oak Technologies OTI-037C/067/077/087 SuperVGA"
  368.      case 11:
  369.           print "Paradise/Western Digital PVGA1A,WD90C00/1x/2x/3x SuperVGA"
  370.      case 12:
  371.           print "Realtek RT3106 SuperVGA"
  372.      case 13:
  373.           print "Trident 8800CS,8900B/C/CL/CX,90x0 SuperVGA"
  374.      case 14:
  375.           print "Tseng Labs ET3000-AX/BX/BP SuperVGA"
  376.      case 15:
  377.           print "Tseng Labs ET4000/W32/W32I SuperVGA"
  378.      case 16:
  379.           print "VESA compatible SuperVGA"
  380.      case 17:
  381.           print "Video 7 HT-208/16 SuperVGA"
  382.      case 18:
  383.           print "Avance Logic AL2101 SuperVGA"
  384.      case 19:
  385.           print "MXIC MX68000/10 SuperVGA"
  386.      case 20:
  387.           print "Primus P2000 SuperVGA"
  388.      case ELSE
  389.           print "Unknown type"
  390. END SELECT
  391.  
  392. mem=whichmem
  393. mem$=str$(mem)
  394. mem$=ltrim$(mem$)
  395. mem$=rtrim$(mem$)
  396.  
  397. print "Your card has "mem$"K of video memory installed."
  398. print
  399. print "Resolutions possible:
  400. print
  401. select case mem
  402.      case is>1279
  403.           print tab(4); "320 X 200 in 256 colors"
  404.           print tab(4); "640 X 400 in 256 colors"
  405.           print tab(4); "640 X 480 in 256 colors"
  406.           print tab(4); "800 X 600 in 256 colors"
  407.           print tab(4); "1024 X 768 in 256 colors"
  408.           print tab(4); "1280 X 1024 in 256 colors"
  409.      case is>1023
  410.           print tab(4); "320 X 200 in 256 colors"
  411.           print tab(4); "640 X 400 in 256 colors"
  412.           print tab(4); "640 X 480 in 256 colors"
  413.           print tab(4); "800 X 600 in 256 colors"
  414.           print tab(4); "1024 X 768 in 256 colors"
  415.      case is>511
  416.           print tab(4); "320 X 200 in 256 colors"
  417.           print tab(4); "640 X 400 in 256 colors"
  418.           print tab(4); "640 X 480 in 256 colors"
  419.           print tab(4); "800 X 600 in 256 colors"
  420.      case else
  421.           print tab(4); "640 X 400 in 256 colors"
  422.           print tab(4); "320 X 200 in 256 colors"
  423. end select
  424. print
  425. print "PLEASE keep in mind that not all monitors support all resolutions."
  426.  
  427. end
  428.  
  429. getvideo:
  430.  
  431. select case monitor%(segment)
  432.      case 1
  433.           print "Monochrome detected."
  434.           print
  435.           print "Resolutions possible:
  436.           print
  437.           print "80 X 25 (text mode only)"
  438.      case 2
  439.           print "Hercules or compatible detected."
  440.           print
  441.           print "Resolutions possible:
  442.           print
  443.           print "720 X 348 X 2"
  444.           print
  445.           print "(This program cannot detect the Hercules InColor card.)
  446.      case 3
  447.           print "CGA detected."
  448.           print
  449.           print "Resolutions possible:
  450.           print "320 X 200 X 4
  451.           print "640 X 200 X 2
  452.      case 4
  453.           print "EGA detected."
  454.           print
  455.           print "Resolutions possible:
  456.           print "320 X 200 X 4
  457.           print "640 X 200 X 2
  458.           print "320 X 200 X 16
  459.           print "640 X 200 X 16
  460.           print "640 X 350 X 4
  461.           print "640 X 350 X 16
  462.      case 5
  463.           print "VGA detected."
  464.           print
  465.           print "Resolutions possible:
  466.           print
  467.           print "320 X 200 X 4
  468.           print "640 X 200 X 2
  469.           print "320 X 200 X 16
  470.           print "640 X 200 X 16
  471.           print "640 X 350 X 4
  472.           print "640 X 350 X 16
  473.           print "640 X 480 X 2
  474.           print "320 X 200 X 256
  475.           print "640 X 480 X 16
  476.      case else
  477.           print "Unable to detect video adapter."
  478. end select
  479.  
  480. return
  481.  
  482. getvga:
  483.  
  484. select case monitor%(segment)
  485.      case 1 to 4
  486.           standard=0
  487.      case 5
  488.           standard=1
  489.      case else
  490.           standard=0
  491. end select
  492.  
  493. return
  494.  
  495.  
  496.  
  497. function monitor%(segment) static
  498.      def seg=0                       'first see if it's color or mono
  499.      segment=&hb800                  'assume color
  500.      if peek(&h463)=&hb4 then
  501.           segment=&hb000                'assign the monochrome segment
  502.           status=inp(&h3bA)             'get the current video status
  503.           for x=1 to 30000              'test for a Hercules 30000 times
  504.                if inp(&h3ba)<>status then
  505.                     monitor%=2                'the port changed, it's a Herc
  506.                     exit function               'all done
  507.                endif
  508.           next
  509.           monitor% = 1                    'it's a plain monochrome
  510.      else                              'it's some sort of color monitor
  511.           inregs.ax=&H1A00              'first test for VGA
  512.           call interrupt(&h10,inregs,outregs)
  513.           if (outregs.ax and &hff)=&h1a then
  514.                monitor%=5                  'it's a VGA
  515.                exit function                 'all done
  516.           endif
  517.           inregs.ax=&h1200              'now test for EGA
  518.           inregs.bx=&h10
  519.           call interrupt(&h10,inregs,outregs)
  520.           if (outregs.bx and &hff)=&h10 then
  521.                monitor%=3                  'if BL is still &H10 it's a CGA
  522.           else
  523.                monitor%=4                  'otherwise it's an EGA
  524.           endif
  525.      endif
  526. end function
  527.  
  528. showpcx:
  529. dim pcxpal as string * 768
  530.  
  531. select case videomode
  532.      case 0:dummyval=res320
  533.      case 1:dummyval=res640l
  534.      case 2:dummyval=res640
  535.      case 3:dummyval=res800
  536.      case 4:dummyval=res1024
  537.      case 5:dummyval=res1280
  538.      case else:end
  539. end select
  540.  
  541. setview 0,0,getmaxx,getmaxy
  542. ok=pcxgetinfo(pcxfilename$,xsize,ysize,numcol,pcxpal)
  543.  
  544. if ok=1 then
  545.      fixit=0
  546.      for a=1 to numcol*3 step 3
  547.           r=asc(mid$(pcxpal,a,1))
  548.           g=asc(mid$(pcxpal,a+1,1))
  549.           b=asc(mid$(pcxpal,a+2,1))
  550.           if r>63 then
  551.                fixit=1
  552.                exit for
  553.           endif
  554.           if g>63 then
  555.                fixit=1
  556.                exit for
  557.           endif
  558.           if b>63 then
  559.                fixit=1
  560.                exit for
  561.           endif
  562.      next a
  563.      if fixit=1 then
  564.           for a=1 to numcol*3
  565.                c=asc(mid$(pcxpal,a,1))
  566.                mid$(pcxpal,a,1)=chr$(c\4)
  567.           next a
  568.      endif
  569.      palset pcxpal,0,255
  570.      ok=pcxput(1,0,0,pcxfilename$)
  571.      if ok<>1 then
  572.           sound 100,5
  573.           return
  574.      endif
  575.      if slshow=1 then
  576.           sleep 5
  577.           return
  578.      endif
  579.      while inkey$=""
  580.      wend
  581. endif
  582. return
  583.  
  584. showslid:
  585.  
  586. filelist$=mid$(command$,4)
  587. open "i",1,filelist$
  588. line input #1, file$(count)
  589. videomode=val(file$(count))
  590.  
  591. while not eof(1)
  592.      count=count+1
  593.      line input #1, file$(count)
  594. wend
  595.  
  596. close 1
  597. count=1
  598.  
  599. while inkey$=""
  600.      if file$(count)="" or count=99 then count=1
  601.      pcxfilename$=file$(count)
  602.      gosub showpcx
  603.      count=count+1
  604. wend
  605.  
  606. videomodeset startvideomode
  607. end
  608.  
  609. artshow:
  610.  
  611. openfile:
  612. videomodeset startvideomode
  613. cls
  614. antialia$="A"
  615. open "i",1,"advertis.txt"
  616.  
  617. printlin:
  618. line input #1, line$
  619. print line$
  620.  
  621. if eof(1) then
  622.      close 1
  623.      locate ,,0
  624.      callgetm:
  625.      gosub getminut
  626.      if doreset=0 then
  627.           videomodeset startvideomode
  628.           goto screendi
  629.      endif
  630.      goto callgetm
  631. endif
  632.  
  633. goto printlin
  634.  
  635. screendi:
  636. whatmode$=right$(command$,1)
  637.  
  638. select case whatmode$
  639.      case "0":
  640.           dummy=res320
  641.           horizont=320
  642.           vertical=200
  643.           colors=256
  644.           setview 0,0,horizont-1,vertical-1
  645.           goto screenx
  646.      case "1":
  647.           dummy=res640l
  648.           horizont=640
  649.           vertical=400
  650.           colors=256
  651.           setview 0,0,horizont-1,vertical-1
  652.           goto screenx
  653.      case "2":
  654.           dummy=res640
  655.           horizont=640
  656.           vertical=480
  657.           colors=256
  658.           setview 0,0,horizont-1,vertical-1
  659.           goto screenx
  660.      case "3":
  661.           dummy=res800
  662.           horizont=800
  663.           vertical=600
  664.           colors=256
  665.           setview 0,0,horizont-1,vertical-1
  666.           goto screenx
  667.      case "4":
  668.           dummy=res1024
  669.           horizont=1024
  670.           vertical=768
  671.           colors=256
  672.           setview 0,0,horizont-1,vertical-1
  673.           goto screenx
  674.      case "5":
  675.           dummy=res1280
  676.           horizont=1280
  677.           vertical=1024
  678.           colors=256
  679.           setview 0,0,horizont-1,vertical-1
  680.           goto screenx
  681.      case else:end
  682. end select
  683.  
  684. screenx:
  685. gosub getminut
  686.  
  687. if doreset=0 then
  688.      goto openfile
  689. endif
  690.  
  691. randomize timer
  692. gosub setpoint
  693. l=p1
  694.  
  695. for p1=sizetype to horizont step 3
  696.      p4=p4-2
  697.      gosub setsymme
  698.      gosub makeline
  699. next
  700.  
  701. a$=inkey$
  702.  
  703. if a$>"" then
  704.      videomodeset startvideomode
  705.      cls
  706.      end
  707. endif
  708.  
  709. goto screenx
  710.  
  711. getminut:
  712. gettime$=time$
  713. minutes$=mid$(gettime$,4,2)
  714. minutes=val(minutes$)
  715.  
  716. if doreset=0 then
  717.      oldminut=minutes
  718.      testfive=oldminut+5
  719.      if oldminut>54 then testfive=0
  720.      doreset=1
  721. endif
  722.  
  723. if testfive=minutes then
  724.      doreset=0
  725.      return
  726. endif
  727.  
  728. a$=inkey$
  729.  
  730. if a$>"" then
  731.      videomodeset startvideomode
  732.      cls
  733.      end
  734. endif
  735.  
  736. return
  737.  
  738. continue:
  739. a$=inkey$
  740. if a$="" goto continue:
  741. return
  742.